home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / SHWRTEST.M < prev    next >
Encoding:
Text File  |  1990-12-21  |  2.5 KB  |  90 lines
  1. MODULE AccDemo;
  2.  
  3.     (*
  4.      *             Demo program for a 'safe' accessory
  5.      *
  6.      *           written by Andreas Pauletti 29.05.1988
  7.      *                   with MEGAMAX MODULA-2
  8.      *
  9.      *
  10.      * Thomas Tempelmann: Durch Abfrage mit der Funktion 'Accessory' kann
  11.      * nun auch das Programm alternativ als Programm mit der Endung PRG
  12.      * (statt ACC) direkt vom Desktop gestartet werden.
  13.      *)
  14.  
  15. (*$E MAC     Endung für Linker: Datei mit Endung ACC erzeugen *)
  16. (*$R-,S-     Keine Bereichs-, Überlauf- und Stackprüfung *)
  17.  
  18. FROM SYSTEM IMPORT ADR;
  19.  
  20. IMPORT GEMEnv;
  21. FROM AESForms IMPORT FormAlert;
  22. FROM AESEvents IMPORT MessageEvent, MessageBuffer, accOpen;
  23. FROM AESMenus IMPORT RegisterAcc;
  24. FROM PrgCtrl IMPORT Accessory;
  25. IMPORT AESMisc, Strings, HdlError, EasyExceptions;
  26.  
  27. VAR
  28.   devHdl: GEMEnv.DeviceHandle;
  29.   gemHdl: GEMEnv.GemHandle;
  30.   menuID: CARDINAL;
  31.   menuEntry: ARRAY[0..19] OF CHAR; (* must be global!! *)
  32.   msg: MessageBuffer;
  33.   done: BOOLEAN;
  34.   retButton: CARDINAL;
  35.  
  36. PROCEDURE DoTheWork;
  37.  
  38.   BEGIN
  39.     AESMisc.ShellWrite (TRUE, AESMisc.graphicPrgm, "D:\GEP_ED.PRG", "");
  40.   END DoTheWork;
  41.  
  42.  
  43. PROCEDURE DoItSafely;
  44.  
  45.   VAR excResult: EasyExceptions.Exception;
  46.       msg: ARRAY [0..99] OF CHAR;
  47.       ok: BOOLEAN;
  48.  
  49.   BEGIN
  50.     EasyExceptions.Call (DoTheWork, excResult);
  51.     IF excResult # EasyExceptions.NormalReturn () THEN
  52.       HdlError.GetErrorMsg (EasyExceptions.StdErrNo (excResult), msg);
  53.       Strings.Insert ("[0][There was an error:|", 0, msg, ok);
  54.       Strings.Append ("|But the system did not crash][Great!]", msg, ok);
  55.       FormAlert(1, msg, retButton)
  56.     END
  57.   END DoItSafely;
  58.  
  59. BEGIN
  60.   GEMEnv.InitGem (GEMEnv.RC, devHdl, done);
  61.   IF done THEN
  62.     gemHdl:= GEMEnv.CurrGemHandle ();
  63.     IF NOT Accessory () THEN
  64.       (*
  65.        * Started as normal program -> activate immediately
  66.        *)
  67.       DoItSafely
  68.     ELSE
  69.       (*
  70.        * Started as accessory -> wait for activation via gem-menu
  71.        *)
  72.       menuEntry:= '  Accessory Demo';
  73.       RegisterAcc(ADR(menuEntry), menuID , done);
  74.       IF done THEN
  75.         LOOP
  76.           MessageEvent(msg);
  77.           IF (msg.msgType = accOpen) THEN
  78.             DoItSafely
  79.           END
  80.         END               (* Endless loop! Accessories never terminate! *)
  81.       ELSE
  82.         FormAlert(1, "[0][Can't install AccDemo][OK]", retButton);
  83.         LOOP  (* dummy-loop *)
  84.           MessageEvent(msg);
  85.         END               (* Endless loop! Accessories never terminate! *)
  86.       END
  87.     END
  88.   END
  89. END AccDemo.
  90.